home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FishMarket 1.0
/
FishMarket v1.0.iso
/
fishies
/
526-550
/
disk_549
/
ffex
/
source
/
ffex.mod
< prev
next >
Wrap
Text File
|
1992-05-06
|
18KB
|
526 lines
(* Modul : FFEX *)
(* Projekt : FFEX (Fast Fractal Exploration Set) *)
(* Autor : Robert Brandner *)
(* Funktion : Hauptmodul von FFEX - Menüabfragen, Zoom, Berechnungen ... *)
(* Copyright: Robert Brandner *)
(* Schillerstr. 3 *)
(* A-8280 Fürstenfeld *)
(* AUSTRIA *)
MODULE FFEX;
FROM Menu IMPORT SetMenu, MenuNum, ItemNum, SubNum, NextSelect;
FROM Render IMPORT SetPixel,GetPixel,FastIter16,FastIter32,LongRealIter,
SetNormalPointer,SetZZZPointer,SetZoomPointer;
FROM Request IMPORT Info, GetLimits, Request;
FROM ArpReq IMPORT GetFileName;
FROM IlbmInOut IMPORT LoadILBM, SaveILBM;
FROM Arts IMPORT Assert, TermProcedure;
FROM SYSTEM IMPORT ADR, ADDRESS, CAST, INLINE, LONGSET;
FROM GfxMacros IMPORT RasSize;
FROM Graphics IMPORT ViewModes,ViewModeSet,FontFlags,FontFlagSet,
TextFontPtr, OpenFont,normalFont,TextAttr,CloseFont,
LoadRGB4, SetRGB4, RastPortPtr,RectFill,SetAPen,
SetRast, Move, Draw, SetDrMd, DrawModeSet,DrawModes,
jam1, BltBitMap;
FROM Intuition IMPORT IntuiMessagePtr, menuNull, ShowTitle, ModifyIDCMP,
ScreenPtr,NewScreen,OpenScreen,CloseScreen,
WindowPtr,NewWindow,OpenWindow,CloseWindow,
WindowFlags,WindowFlagSet,ScreenFlags,ScreenFlagSet,
customScreen, IDCMPFlagSet, IDCMPFlags, ScreenToFront,
ClearMenuStrip, menuDown, menuUp, selectDown, selectUp;
FROM Exec IMPORT FindTask, TaskPtr, GetMsg, ReplyMsg, WaitPort, CopyMem;
FROM Dos IMPORT ProcessPtr;
CONST
SCREENTITLE="Fast Fractal Exploration Set 4.0";
TOPAZ="topaz.font";
LIMIT=4; (* bis zu dieser Größe werden Rechtecke gevierte(i)lt *)
ESCAPE=045H;
MENUFLAGS=IDCMPFlagSet{menuVerify,menuPick,mouseButtons};
STARTPIC="FFEXStart.pic";
TYPE
IterProc=PROCEDURE(LONGREAL,LONGREAL,LONGINT):LONGINT;
VAR
ns : NewScreen;
nw : NewWindow;
Iterations: IterProc;
win : WindowPtr;
scr : ScreenPtr;
topaz80 : TextFontPtr;
attr : TextAttr;
thisTask : ProcessPtr;
QUIT,title: BOOLEAN;
yadr : ARRAY[0..512] OF LONGINT;
rp : RastPortPtr;
msg : IntuiMessagePtr;
class : IDCMPFlagSet;
code : CARDINAL;
xres,yres,depth,i,maxcol: INTEGER;
xmin,ymin,xmax,ymax : LONGREAL; (* Koord. des zu zeichnenden Bildes *)
xminr,yminr,xmaxr,ymaxr : LONGREAL; (* Koord. des letzten gez. Bildes *)
x1,y1,x2,y2 : LONGREAL; (* Hilfsvariablen *)
maxiter : LONGINT;
zx,zy,zdx,zdy : INTEGER; (* Zoomrahmen *)
fileok : BOOLEAN;
fname : ARRAY[0..255] OF CHAR; (* für Filerequester *)
saved : BOOLEAN;
mess : ARRAY[0..80] OF CHAR;
no,yes : ARRAY[0..9] OF CHAR;
PROCEDURE TextColorsOn; FORWARD;
PROCEDURE TextColorsOff; FORWARD;
PROCEDURE CreateDisplay(w,h,d:INTEGER); FORWARD;
PROCEDURE LoadIff(fn:BOOLEAN);
VAR
i,planebytes,ok:LONGINT;
lscr:ScreenPtr;
BEGIN
IF NOT saved THEN
mess:="This picture is not saved!|If you continue, it will be lost!";
yes:="CONTINUE"; no:="CANCEL";
IF NOT Request(win,mess,yes,no) THEN RETURN END;
END;
INCL(win^.flags,rmbTrap);
ModifyIDCMP(win,IDCMPFlagSet{});
IF fn THEN
TextColorsOn;
fileok:=GetFileName(win,ADR("Load File"),ADR(fname));
TextColorsOff;
ELSE
fileok:=TRUE
END;
IF fileok THEN
SetZZZPointer(win);
fileok:=LoadILBM(fname,win,lscr,xminr,yminr,xmaxr,ymaxr,maxiter);
IF fileok THEN
xmin:=xminr; ymin:=yminr; xmax:=xmaxr; ymax:=ymaxr;
IF (lscr^.width#xres) OR (lscr^.height#yres) THEN
CreateDisplay(lscr^.width,lscr^.height,INTEGER(lscr^.bitMap.depth));
END;
saved:=TRUE;
ShowTitle(scr,FALSE);
ok:=BltBitMap(ADR(lscr^.bitMap),0,0,ADR(scr^.bitMap),0,0,
xres,yres,0C0H,0FFH,NIL);
ShowTitle(scr,title);
CloseScreen(lscr);
END;
SetNormalPointer(win);
END;
EXCL(win^.flags,rmbTrap);
ModifyIDCMP(win,MENUFLAGS);
END LoadIff;
PROCEDURE SaveIff;
BEGIN
ClearMenuStrip(win);
ModifyIDCMP(win,IDCMPFlagSet{});
TextColorsOn;
fileok:=GetFileName(win,ADR("Save File"),ADR(fname));
TextColorsOff;
IF fileok THEN
INCL(win^.flags,rmbTrap);
SetZZZPointer(win); ShowTitle(scr,FALSE);
fileok:=SaveILBM(fname,scr,xminr,yminr,xmaxr,ymaxr,maxiter);
saved:=fileok;
SetNormalPointer(win); ShowTitle(scr,title); EXCL(win^.flags,rmbTrap);
END;
ModifyIDCMP(win,MENUFLAGS);
SetMenu(win);
END SaveIff;
(*** Prozeduren für Screen und Window ********************************)
PROCEDURE ColorTable; (* $E- *)
BEGIN
INLINE(00000H,00FF0H,00FD0H,00FB0H,00F80H,00F60H,00F40H,00F20H,
00F00H,00F02H,00F05H,00F07H,00F09H,00F0BH,00F0DH,00F0FH,
00D0FH,00B0FH,0090FH,0070FH,0050FH,0030FH,0010FH,0001FH,
0003FH,0005FH,0007FH,0009FH,000BFH,000DFH,000FFH,00DDDH);
END ColorTable;
PROCEDURE CloseIfOpen;
BEGIN
thisTask:=CAST(ProcessPtr,FindTask(NIL));
thisTask^.windowPtr:=NIL;
IF win#NIL THEN CloseWindow(win); win:=NIL END;
IF scr#NIL THEN CloseScreen(scr); scr:=NIL END;
END CloseIfOpen;
PROCEDURE CreateDisplay(w,h,d:INTEGER);
BEGIN
xres:=w; yres:=h; depth:=d; (* Werte für DrawFractal/Zoom merken *)
IF NOT saved THEN
mess:="This picture is not saved!|If you continue, it will be lost!";
yes:="CONTINUE"; no:="CANCEL";
IF NOT Request(win,mess,yes,no) THEN RETURN END;
END;
CloseIfOpen;
WITH ns DO
width:=w; height:=h; depth:=d; detailPen:=6; blockPen:=1;
viewModes:=ViewModeSet{};
IF w>320 THEN INCL(viewModes,hires) END;
IF h>256 THEN INCL(viewModes,lace) END;
type:=customScreen+ScreenFlagSet{screenBehind};
font:=ADR(attr); defaultTitle:=ADR(SCREENTITLE);
gadgets:=NIL; customBitMap:=NIL;
END;
scr:=OpenScreen(ns);
Assert(scr#NIL,ADR("OpenScreen() failed!"));
LoadRGB4(ADR(scr^.viewPort),ADR(ColorTable),32);
IF d=5 THEN maxcol:=31 ELSE maxcol:=15 END;
WITH nw DO
width:=w; height:=h; detailPen:=3; blockPen:=1;
idcmpFlags:=IDCMPFlagSet{menuVerify, menuPick, mouseButtons};
flags:=WindowFlagSet{reportMouse,backDrop,borderless,
activate,noCareRefresh};
firstGadget:=NIL;checkMark:=NIL;title:=NIL;
screen:=scr; bitMap:=NIL;
minWidth:=0; minHeight:=0; maxWidth:=-1; maxHeight:=-1;
type:=customScreen;
END;
win:=OpenWindow(nw);
Assert(win#NIL,ADR("OpenWindow() failed!"));
rp:=win^.rPort;
FOR i:=0 TO h-1 DO (* Zeilenadressen berechnen *)
yadr[i]:=LONGINT(i)*LONGINT(rp^.bitMap^.bytesPerRow);
END;
ScreenToFront(scr);
thisTask:=CAST(ProcessPtr,FindTask(NIL)); (* Systemrequester auf *)
thisTask^.windowPtr:=win; (* eigenem Screen. *)
SetMenu(win);
title:=TRUE; ShowTitle(scr,title);
END CreateDisplay;
(*** Prozeduren für Fraktalgrafik ************************************)
PROCEDURE DrawFractal(rmin,rmax,imin,imax:LONGREAL;
maxcol:INTEGER;
maxiter:LONGINT);
VAR
r,cxr,cyr,dxr,dyr:LONGREAL;
lc:LONGINT;
exit:BOOLEAN;
PROCEDURE HLine(xmin,xmax,y:INTEGER); (* waagrechte Linie *)
BEGIN
cxr:=rmin+LONGREAL(xmin)*dxr;cyr:=imin+LONGREAL(y)*dyr;
FOR i:=xmin TO xmax DO
lc:=Iterations(cxr,cyr,maxiter);cxr:=cxr+dxr;
SetPixel(i,yadr[y],lc,maxiter,maxcol,ADR(rp^.bitMap^.planes[0]));
END
END HLine;
PROCEDURE VLine(ymin,ymax,x:INTEGER); (* senkrechte Linie *)
BEGIN
cxr:=rmin+LONGREAL(x)*dxr;cyr:=imin+LONGREAL(ymin)*dyr;
FOR i:=ymin TO ymax DO
lc:=Iterations(cxr,cyr,maxiter);cyr:=cyr+dyr;
SetPixel(x,yadr[i],lc,maxiter,maxcol,ADR(rp^.bitMap^.planes[0]));
END
END VLine;
PROCEDURE Rectangle(xmin,ymin,xmax,ymax:INTEGER);
VAR
eq:BOOLEAN;
dx2,dy2,k:INTEGER;
BEGIN
IF exit THEN RETURN END;
msg:=GetMsg(win^.userPort);
IF msg#NIL THEN
ReplyMsg(msg);
IF msg^.code=ESCAPE THEN exit:=TRUE END;
END;
dx2:=(xmax-xmin);dy2:=(ymax-ymin);
IF (dx2<2) OR (dy2<2) THEN RETURN END;
IF (dx2<LIMIT) OR (dy2<LIMIT) THEN
FOR k:=ymin+1 TO ymax-1 DO HLine(xmin+1,xmax-1,k) END;
RETURN;
END;
dx2:=(1+dx2) DIV 2;dy2:=(1+dy2) DIV 2;
lc:=GetPixel(xmin,yadr[ymin],depth, ADR(rp^.bitMap^.planes[0]));
i:=xmin;eq:=TRUE;
REPEAT
INC(i);
eq:=(lc=GetPixel(i,yadr[ymin],depth,ADR(rp^.bitMap^.planes[0]))) &
(lc=GetPixel(i,yadr[ymax],depth,ADR(rp^.bitMap^.planes[0])));
UNTIL (i=xmax) OR NOT eq;
IF eq THEN
i:=ymin;
REPEAT
INC(i);
eq:=(lc=GetPixel(xmin,yadr[i],depth,ADR(rp^.bitMap^.planes[0]))) &
(lc=GetPixel(xmax,yadr[i],depth,ADR(rp^.bitMap^.planes[0])));
UNTIL (i=ymax) OR NOT eq;
END;
IF eq THEN (* ganzer Rand einfärbig => Rechteck einfärbig *)
SetAPen(rp,lc);RectFill(rp,xmin,ymin,xmax,ymax);
ELSE
(* Rechteck vierteln, und alle Viertel testen *)
HLine(xmin+1,xmax-1,ymin+dy2);
VLine(ymin+1,ymax-1,xmin+dx2);
Rectangle(xmin,ymin,xmin+dx2,ymin+dy2);
Rectangle(xmin+dx2,ymin,xmax,ymin+dy2);
Rectangle(xmin,ymin+dy2,xmin+dx2,ymax);
Rectangle(xmin+dx2,ymin+dy2,xmax,ymax);
END;
END Rectangle;
BEGIN (* DrawFractal *)
INCL(win^.flags,rmbTrap);
ShowTitle(scr,FALSE); SetZZZPointer(win);
ModifyIDCMP(win,IDCMPFlagSet{rawKey});
ClearMenuStrip(win);
saved:=FALSE;
SetRast(rp,0);
dxr:=(rmax-rmin)/LONGREAL(xres);
dyr:=(imax-imin)/LONGREAL(yres);
IF zx#-1 THEN (* wenn Zoomrahmen, dann diesen Ausschnitt zeichnen *)
r:=rmin;
rmin:=r+LONGREAL(zx-zdx)*dxr;
rmax:=r+LONGREAL(zx+zdx)*dxr;
r:=imin;
imin:=r+LONGREAL(zy-zdy)*dyr;
imax:=r+LONGREAL(zy+zdy)*dyr;
dxr:=(rmax-rmin)/LONGREAL(xres);
dyr:=(imax-imin)/LONGREAL(yres);
zx:=-1; (* Damit der Rahmen anschließend nicht gezeichnet wird *)
END;
xminr:=rmin; xmaxr:=rmax; yminr:=imin; ymaxr:=imax;
xmin:=rmin; xmax:=rmax; ymin:=imin; ymax:=imax;
exit:=FALSE;
HLine(0,xres-1,0);VLine(0,yres-1,xres-1); (* Anfangs- *)
HLine(0,xres-1,yres-1);VLine(0,yres-1,0); (* rechteck *)
Rectangle(0,0,xres-1,yres-1);
EXCL(win^.flags,rmbTrap);
SetMenu(win);
ModifyIDCMP(win,IDCMPFlagSet{menuPick,menuVerify,mouseButtons});
ShowTitle(scr,title); SetNormalPointer(win);
END DrawFractal;
(*** Prozeduren für Zoom *********************************************)
PROCEDURE DrawFrame(x1,y1,dx,dy:INTEGER);
BEGIN
SetAPen(rp,15); (* 4 Bitplanes beeinflussen *)
SetDrMd(rp,DrawModeSet{complement}); (* Bild nicht zerstören *)
Move(rp,x1-dx,y1-dy);
Draw(rp,x1+dx,y1-dy);Draw(rp,x1+dx,y1+dy);
Draw(rp,x1-dx,y1+dy);Draw(rp,x1-dx,y1-dy);
SetDrMd(rp,jam1);
END DrawFrame;
PROCEDURE Zoom; (* Ausschnitt wählen, unverzerrt! *)
VAR
x1,y1,dx,dy,mx,my:INTEGER;
r,dxr,dyr:LONGREAL;
BEGIN
IF zx#-1 THEN DrawFrame(zx,zy,zdx,zdy) END; (* Rahmen löschen *)
xmin:=xminr; xmax:=xmaxr;
ymin:=yminr; ymax:=ymaxr;
ModifyIDCMP(win,IDCMPFlagSet{mouseButtons,mouseMove});
ShowTitle(scr,FALSE);
SetZoomPointer(win);
REPEAT (* warten bis Maustaste gedrückt *)
WaitPort(win^.userPort);
msg:=GetMsg(win^.userPort);
ReplyMsg(msg);
UNTIL (mouseButtons IN msg^.class);
IF (msg^.code = menuDown) THEN (* RMB => Abbruch *)
ShowTitle(scr,title); SetNormalPointer(win);
ModifyIDCMP(win,MENUFLAGS);
zx:=-1;
RETURN;
END;
IF (msg^.code = selectDown) THEN (* LMB => Zoomen *)
x1:=msg^.mouseX; y1:=msg^.mouseY; (* Mittelpunkt *)
dx:=0;dy:=0;
DrawFrame(x1,y1,dx,dy); (* ersten Rahmen zeichnen *)
LOOP
msg:=GetMsg(win^.userPort);
IF msg#NIL THEN
IF (mouseButtons IN msg^.class) & (msg^.code = menuDown) THEN
DrawFrame(x1,y1,dx,dy); (* Rahmen löschen *)
zx:=-1; (* merken, daß Rahmen gelöscht *)
ReplyMsg(msg);
ShowTitle(scr,title); SetNormalPointer(win);
ModifyIDCMP(win,MENUFLAGS);
RETURN;
END;
IF (mouseButtons IN msg^.class) & (msg^.code = selectUp) THEN
(* Position der Maus merken (für Rechteck) *)
mx:=msg^.mouseX;my:=msg^.mouseY;
ReplyMsg(msg);
zx:=x1; zy:=y1; zdx:=dx; zdy:=dy; (* Merken, wo der Rahmen ist *)
EXIT;
END;
IF (mouseMove IN msg^.class) THEN
DrawFrame(x1,y1,dx,dy); (* alten Rand löschen *)
mx:=msg^.mouseX;my:=msg^.mouseY;
dx:=x1-mx; dy:=y1-my;
dx:=ABS(dx); dy:=ABS(dy);
(* Skalierung. hoffentlich richtig *)
IF (dy>dx) THEN
dx:=(xres*dy)/yres;
ELSE
dy:=(yres*dx)/xres;
END;
DrawFrame(x1,y1,dx,dy); (* neuen Rand zeichnen *)
END;
ReplyMsg(msg);
END;
END;
END;
ShowTitle(scr,title); SetNormalPointer(win);
ModifyIDCMP(win,MENUFLAGS);
END Zoom;
(*** Prozeduren für Userinterface ************************************)
PROCEDURE TextColorsOn;
BEGIN
SetRGB4(ADR(scr^.viewPort),1,13,13,13);
SetRGB4(ADR(scr^.viewPort),2,8,8,8);
SetRGB4(ADR(scr^.viewPort),3,5,5,5);
SetRGB4(ADR(scr^.viewPort),30,5,5,5);
SetRGB4(ADR(scr^.viewPort),14,5,5,5);
SetRGB4(ADR(scr^.viewPort),28,14,14,14);
SetRGB4(ADR(scr^.viewPort),12,14,14,14);
SetRGB4(ADR(scr^.viewPort),15,13,13,13);
END TextColorsOn;
PROCEDURE TextColorsOff;
BEGIN
LoadRGB4(ADR(scr^.viewPort),ADR(ColorTable),32);
END TextColorsOff;
PROCEDURE MenuHandler;
VAR
selection, menuNum, itemNum, subNum : CARDINAL;
BEGIN
LOOP
msg:=GetMsg(win^.userPort);
IF msg=NIL THEN EXIT END;
class:=msg^.class;
code :=msg^.code;
IF class=IDCMPFlagSet{menuVerify} THEN
TextColorsOn;
END;
ReplyMsg(msg); (* muß nach menuVerify-Abfrage stehen *)
IF (mouseButtons IN class) & (code=menuUp) THEN
TextColorsOff;
END;
IF menuPick IN class THEN
selection:=code;
WHILE selection#menuNull DO
menuNum:=MenuNum(selection);
itemNum:=ItemNum(selection);
subNum :=SubNum(selection);
CASE menuNum OF
0 : (* Project Menü *)
CASE itemNum OF
0 : LoadIff(TRUE); zx:=-1;|
1 : SaveIff;| (* -""- *)
2 : ClearMenuStrip(win);
ModifyIDCMP(win,IDCMPFlagSet{});
TextColorsOn; Info(win); TextColorsOff;
SetMenu(win);
ModifyIDCMP(win,MENUFLAGS);
EXIT;|
3 : IF NOT saved THEN
mess:="Really quit?!|Picture will be lost!";
yes:="QUIT!"; no:="NO!";
IF Request(win,mess,yes,no) THEN
QUIT:=TRUE; EXIT;
END
ELSE
QUIT:=TRUE; EXIT;
END;|
ELSE;
END;|
1 : (* Setup Menü *)
CASE itemNum OF
0 : (* Auflösung *)
CASE subNum OF
0 : zx:=-1; CreateDisplay(320, 256, 5); EXIT;|
1 : zx:=-1; CreateDisplay(640, 256, 4); EXIT;|
2 : zx:=-1; CreateDisplay(640, 512, 4); EXIT;|
ELSE;
END;|
1 : (* Algorithmen *)
CASE subNum OF
0 : Iterations:=FastIter16;|
1 : Iterations:=FastIter32;|
2 : Iterations:=LongRealIter;|
ELSE;
END;|
2 : ClearMenuStrip(win);
ModifyIDCMP(win,IDCMPFlagSet{});
TextColorsOn;
GetLimits(scr,xmin,xmax,ymin,ymax,maxiter);
TextColorsOff;
IF (zx#-1) AND
((xminr#xmin) OR (xmaxr#xmax) OR (* bei neuen *)
(yminr#ymin) OR (ymaxr#ymax)) THEN (* Grenzen *)
DrawFrame(zx,zy,zdx,zdy); zx:=-1; (* Rahmen *)
END; (* löschen *)
SetMenu(win);
ModifyIDCMP(win,MENUFLAGS);|
ELSE;
END;|
2 : (* Action Menü *)
CASE itemNum OF
0 : TextColorsOff; title:=NOT title; ShowTitle(scr, title);|
1 : TextColorsOff; Zoom;|
2 : TextColorsOff;
DrawFractal(xmin,xmax,ymin,ymax,maxcol,maxiter); |
ELSE;
END;|
ELSE;
END;
selection:=NextSelect(selection);
END; (* WHILE *)
END; (* IF *)
END; (* LOOP *)
END MenuHandler;
PROCEDURE CleanUp;
BEGIN
CloseIfOpen;
IF topaz80#NIL THEN CloseFont(topaz80) END;
END CleanUp;
BEGIN
TermProcedure(CleanUp);
WITH attr DO
name :=ADR(TOPAZ); ySize:=8; style:=normalFont;
flags:=FontFlagSet{romFont,designed};
END;
topaz80:=OpenFont(ADR(attr));
saved:=TRUE;
zx:=-1; (* noch kein Zoomrahmen gezeichnet *)
title:=TRUE; (* Titlebar sichtbar *)
QUIT:=FALSE;
xres:=320; yres:=256; depth:=5; (* Anfangsauflösung *)
Iterations:=FastIter16;
fname:="FFEX_Start.pic";
CreateDisplay(xres, yres, depth);
LoadIff(FALSE);
REPEAT
WaitPort(win^.userPort);
MenuHandler;
UNTIL QUIT;
END FFEX.